COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE IMPSTAT
C00005 00003	Start of program
C00007 00004	Set up display of IMP status
C00009 00005	 Local socket, byte size, state
C00011 00006	 Allocations
C00013 00007	Display it!
C00015 00008	Random stuff
C00017 ENDMK
C⊗;
TITLE IMPSTAT

; Display IMP status.  Display routines based on ME routines in UUO manual

X==1 ? Y==2 ? Z==3 ? L==4 ? I==5 ? N==6 ? DDB==7 ? J==10 ? P==17

; GETLIN bits

IIILIN==400000,,			; terminal is a III
DMLIN==	040000,,			; terminal is a DM
DDDLIN==020000,,			; terminal is a DD

ILM==	020000				; MPV occured

; Data Risc command word

DEFINE CW ?C1,B1,C2,B2,C3,B3
 <<B1←28.>\<B2←20.>\<B3←12.>\<C1←9.>\<C2←6.>\<C3←3>\4>
TERMIN

; Data Risc command names

EXCT==	0				; execute
FNCN==	1				; function, usual value bytes
	ALPHBG==6 ? ALPHA==46
CHNL==	2				; channel select
COLM==	3				; column select
HILIN==	4				; set high 5 bits of line address
LOLIN==	5				; set low 4 bits of line address

; IMP status bits

RFCS==	200000,,			; RFC sent
RFCR==	100000,,			; RFC received
CLSS==	040000,,			; CLS sent
CLSR==	020000,,			; CLS received

; IMP DDB stuff

DEVCHR==400001				; characteristics
DEVIOS==400002				; I/O status
 ALLW==	020000,,			; allocation wait
MAL==	400014				; message allocation
BAL==	400015				; bit allocation
NHMA==	400016				; nominal message allocation
NHBA==	400017				; nominal bit allocation
HMA==	400022				; remote message allocation
HBA==	400023				; remote bit allocation
MIIL==	400024				; messages in input list
BIIL==	400025				; bits in input list

; Pointers into the monitor

FFLNK:	0				; first free link
; Pntrs indexed up by 1, so RH is addr-1
LNKTAB:	(I)				; host-link number
IMPDDB:	(I)				; address of DDB
IMPLS:	(I)				; local socket number
IMPFS:	(I)				; foreign socket number
IMPBS:	(I)				; byte size
IMPSTB:	(I)				; link status
; Ordinary pointers
PRJPRG:	(J)				; PPN
JOBNAM:	(J)				; program name

; Random data

PDLLEN==50.

PDL:	BLOCK PDLLEN
LINCNT:	BLOCK 1				; line count
SUBTTL Start of program

IMPSTA:	JFCL
	RESET
	MOVE P,[PDL(-PDLLEN)]

; Make sure we never lose with MPV

	MOVEI [	MOVEM JOBVER		; stuff 0 away some random place
		MOVE JOBREL
		ADDI 2000		; another K of core, please
		CORE
		 JRST 4,IMPSTA
		MOVE JOBVER
		JRST 2,@JOBTPC]		; dismiss interrupt
	MOVEM JOBAPR
	MOVEI ILM
	APRENB

; Snarf up some monitor symbols

	MOVEI X,[.RSQZ 0,FFLNK ? 0]
	.SYML X,
	 JRST 4,.-1
	ADDI X,400000
	MOVEM X,FFLNK
	IRPS SYM,,LNKTAB IMPDDB IMPLS IMPFS IMPBS IMPSTB
	 MOVEI X,[.RSQZ 0,SYM ? 0]
	 .SYML X,
	  JRST 4,.-1
	 ADDI X,377777
	 HRRM X,SYM
	TERMIN
	IRPS SYM,,PRJPRG JOBNAM
	 MOVEI X,[.RSQZ 0,SYM ? 0]
	 .SYML X,
	  JRST 4,.-1
	 ADDI X,400000
	 HRRM X,SYM
	TERMIN

; Map the monitor in

	MOVSI 377777
	SETPR2
	 JRST 4,.-1

; Get terminal characteristics

	SETO L,				; this console
	GETLIN L
	AOJE L,[EXIT]			; detached
	HRROI [015000,,LINCNT]
	TTYSET
	MOVNI 4
	ADDM LINCNT
	PPSEL 1
	DPYPOS -452			; near botton of screen
	DPYSIZ 3002			; 3 glitches, 2 lines/glitch
;	JRST GETNET
SUBTTL Set up display of IMP status

; Initialize statistics printer

GETNET:	SETZM SCREEN
	MOVE [SCREEN,,SCREEN+1]
	BLT @SCREND
	MOVE X,[440700,,SCREEN]
	PUSH P,LINCNT
	SETZM LINCNT
	TLNN (DMLIN)
	 JRST HDNODM
	MOVEI 177
	IDPB X
	MOVEI ↑W
	IDPB X
HDNODM:	SKIPN I,@FFLNK
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/                  Nobody is using the IMP!
/
		JRST MSGEND]
	JSP Y,TXTSTR
	 ASCIZ/Idx Hst Lnk   For'n skt   Local skt BS Status Job  User  Subsys Allocs
/
	TLNN (DMLIN)
	 JRST NXTLNK
	MOVEI 177
	IDPB X
	MOVEI ↑W
	IDPB X

; Individual link print routine

NXTLNK:	MOVEI <" >
	IDPB X
	MOVEI Y,(I)
	MOVEI N,2
	PUSHJ P,OCTOUT			; table index
	MOVEI <" >
	IDPB X
	LDB Y,[101000,,@LNKTAB]
	MOVEI N,3
	PUSHJ P,OCTOUT			; host number
	MOVEI <" >
	IDPB X
	LDB Y,[001000,,@LNKTAB]
	MOVEI N,3
	PUSHJ P,OCTOUT			; link number
	MOVEI <" >
	IDPB X
	MOVE Y,@IMPFS			; foreign socket number
	CAMN Y,[-1]
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/  listening/
		JRST DPYLS]
	MOVEI N,11.
	PUSHJ P,OCTOUT
; (continued on next page)
; Local socket, byte size, state

DPYLS:	MOVEI <" >
	IDPB X
	MOVE Y,@IMPLS			; local socket number
	MOVEI N,11.
	PUSHJ P,OCTOUT
	MOVEI <" >
	IDPB X
	MOVE Y,@IMPBS			; byte size
	MOVEI N,2
	PUSHJ P,DECOUT
	MOVE @IMPSTB
	TLNN (CLSS\CLSR)
	 JRST NOTCLS
	TLNN (CLSS)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ CLSFH /
		JRST STADUN]
	TLNN (CLSR)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ CLSSNT/
		JRST STADUN]
	JSP Y,TXTSTR
	 ASCIZ/ CLOSED/
	JRST STADUN
NOTCLS:	TLNN (RFCS\RFCR)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ LISTEN/
		JRST STADUN]
	TLNN (RFCS)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ RFCFH /
		JRST STADUN]
	TLNN (RFCR)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ RFCSNT/
		JRST STADUN]
	JSP Y,TXTSTR
	 ASCIZ/ OPENED/

; Start of DDB stuff

STADUN:	SKIPN DDB,@IMPDDB
	 JRST NODDB			; no DDB for this guy
	MOVEI <" >
	IDPB X
	MOVE Y,DEVCHR(DDB)
	LSH Y,-30.
	MOVEI J,(Y)
	MOVEI N,3
	PUSHJ P,DECOUT
	MOVEI <" >
	IDPB X
	MOVE Y,@PRJPRG
	PUSHJ P,SIXOUT
	MOVEI <" >
	IDPB X
	MOVE Y,@JOBNAM
	PUSHJ P,SIXOUT
	MOVEI <" >
	IDPB X
	MOVE Y,DEVIOS(DDB)
	TLNE Y,(ALLW)
	 MOVEI "W
	IDPB X
; (continued on next page)
; Allocations

	MOVE @IMPLS
	TRNN 1				; send or receive?
	 JRST [	MOVE Y,HMA(DDB)		; receive; foreign message allocation
		PUSHJ P,DECOUT
		MOVEI "/
		IDPB X
		MOVE Y,HBA(DDB)
		PUSHJ P,DECOUT
		SKIPN Y,MIIL(DDB)	; messages in input list
		 JRST NODDB
		MOVEI <" >
		IDPB X
		MOVEI "[
		IDPB X
		PUSHJ P,DECOUT
		MOVEI "/
		IDPB X
		MOVE Y,BIIL(DDB)	; bits in input list
		PUSHJ P,DECOUT
		MOVEI "]
		IDPB X
		JRST NODDB]
	MOVE Y,MAL(DDB)			; send socket; message allocation
	PUSHJ P,DECOUT			; note N←-1 from last DECOUT call
	MOVEI "/
	IDPB X
	MOVE Y,BAL(DDB)			; bit allocation
	PUSHJ P,DECOUT
	MOVEI <" >
	IDPB X
NODDB:	JSP Y,TXTSTR
	 ASCIZ/
/
	AOS LINCNT
	TLNN (DMLIN)
	 JRST NODDB0
	MOVEI 177
	IDPB X
	MOVEI ↑W
	IDPB X
NODDB0:	SOJG I,NXTLNK

; Went through all the links

MSGEND:	POP P,Z
	TLNE L,(DDDLIN\DMLIN)
CLREOF:	 CAMGE Z,LINCNT
	  JRST NODDDM			; III or printing
	MOVEI 177
	TLNE L,(DMLIN)
	 IDPB X
	TLNE L,(DMLIN)
	 SKIPA Y,[↑W]
	  MOVEI Y,<" >
	IDPB Y,X
	MOVEI ↑M
	IDPB X
	MOVEI ↑J
	IDPB X
	SOJA Z,CLREOF
; (continued on next page)
SUBTTL Display it!

NODDDM:	TLNN X,700000			; if at word boundry
	 ADDI X,1
	SETZM 1(X)			; HALT to stop program
	MOVEI X,(X)
	MOVEM X,SCREND
	MOVEI 2(X)
	SUBI DPPROG
	MOVEM DPHEAD+1			; save display program length
	AOS (X)
	CAIE X,SCREEN
	 SOJA X,.-2

; Now output the accumulated text

	TLNN L,(DDDLIN\IIILIN\DMLIN)
	 JRST [	OUTSTR SCREEN
		OUTSTR [ASCIZ/

/]
		JRST DELAY]
	JUMPL L,DOIII
	TLNE L,(DMLIN)
	 JRST [	SETZM DPPROG
		MOVE X,[.BYTE 7 ? 177 ? ↑L ? 140 ? 143]; cursor at fourth line
		JRST DODM]
	MOVE TXTOUT
	MOVEM DPPROG
	SKIPA X,COLPOS
DOIII:	 MOVE X,[.BYTE 11.,11.,3,3,2,2,4 ? -777 ? 640 ? 2 ? 3 ? 1 ? 2 ? 6]
DODM:	MOVEM X,DPPROG+1
	UPGIOT 1,DPHEAD			; display the text

; Done, wait twenty seconds and go again

DELAY:	MOVEI 20.
	TLNE L,(DDDLIN\IIILIN)
	 MOVEI 1
	TLNE L,(DMLIN)
	 MOVEI 5.
	SLEEP
	INCHRS
	 CAIA
	  JRST [CAIN ↑M
		 INCHRW
		PPSEL
		EXIT 1,
		PPSEL 1
		DPYPOS -452		; near botton of screen
		DPYSIZ 3002		; 3 glitches, 2 lines/glitch
		HRROI [015000,,LINCNT]
		TTYSET
		MOVNI 4
		ADDM LINCNT
		JRST GETNET]
	JRST GETNET
SUBTTL Random stuff

; Octal/decimal output of Y.  If N > 0, pad with spaces so it fits in N digits

DECOUT:	SKIPA Z,[10.]
OCTOUT:	 MOVEI Z,8.
	HRRM Z,NUMOUT			; I don't want to fry another AC
NUMOUT:	IDIVI Y,
	ADDI Z,"0
	PUSH P,Z
	SOSG N
	 JRST NUMOU1
	JUMPN Y,NUMOU2
	MOVEI Z,<" >
	IDPB Z,X
	SOJG N,.-1
	JRST NUMOU3
NUMOU1:	SKIPE Y
NUMOU2:	 PUSHJ P,NUMOUT
NUMOU3:	POP P,Y
	IDPB Y,X
	POPJ P,

; Sixbit output routine

SIXOUT:	MOVEI N,6
	SETZ Z,
	ROTC Y,6
	ADDI Z,"A-'A
	IDPB Z,X
	SOJG N,SIXOUT+1
	POPJ P,

; Output text string, called with JSP

TXTSTR:	HRLI Y,440700
	ILDB Y
	JUMPE 1(Y)
	IDPB X
	JRST TXTSTR+1

...LIT:	CONSTA

SCREND:	@JOBREL				; pointer to last word of display

; Display program stuff

COLPOS:	CW COLM,2,HILIN,2,LOLIN,4	; second column, fourth line
TXTOUT:	CW FNCN,ALPHA,CHNL,0,FNCN,ALPHA	; text output

ERASE:	ERASEP ? 2			; erase DD screen
ERASEP:	CW FNCN,17,CHNL,0,FNCN,ALPHA
	0

DPHEAD:	200000,,DPPROG			; double field mode
	0				; size
	0
	DPPROG+1			; address of low order line select for DD

DPPROG:	BLOCK 2				; some space
SCREEN:	0				; display screen image

END IMPSTAT